home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
os2
/
freetype.zip
/
stacktv.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-07
|
2KB
|
105 lines
(* The Turbo Vision Stack Component. Part of the FreeType Debugger *)
unit StackTV;
interface
uses Objects, Views, Drivers, TTTypes, TTDebug;
type
{ TStackView }
{ A Simple stack display }
PStackView = ^TStackView;
TStackView = object( TScroller )
Pile : PStorage;
Top : ^Int;
constructor Init( var Bounds : TRect;
APile : PStorage;
var ATop : Int;
AVScrollBar : PScrollBar );
procedure Draw; virtual;
procedure Update;
end;
{ TStackWindow }
PStackWindow = ^TStackWindow;
TStackWindow = object( TWindow )
V : PScrollBar;
S : PStackView;
constructor Init( var Bounds : TRect;
APile : PStorage;
var ATop : Int );
end;
implementation
{ TStackView }
constructor TStackView.Init;
begin
inherited Init( Bounds, nil, AVScrollBar );
Pile := APile;
Top := @ATop;
Update;
end;
procedure TStackView.Draw;
var
B : TDrawBuffer;
Color : Byte;
I, Item : Int;
S : String[16];
begin
Color := GetColor(1);
if Top^ <= Size.Y then Item := Size.Y-1 else Item := Top^-1-Delta.Y;
for I := 0 to Size.Y-1 do
begin
MoveChar( B, ' ', Color, Size.X );
if Item < Top^ then
begin
S := Hex16( Item ) + ': ' + Hex32( Pile^[Item] );
MoveStr( B, S, Color );
end;
WriteLine( 0, I, Size.X, 1, B );
dec( Item );
end;
end;
procedure TStackView.Update;
begin
if Top^ <= Size.Y then SetLimit( 0, 0 )
else SetLimit( 0, Top^-Size.Y );
ScrollTo( 0, 0 );
end;
{ TStackWindow }
constructor TStackWindow.Init;
var
R : TRect;
begin
inherited Init( Bounds, 'Pile', wnNoNumber );
R := Bounds;
R.A.X := R.B.X-1;
inc( R.A.Y );
dec( R.B.Y );
New( V, Init(R) );
R := Bounds;
R.Grow(-1,-1);
New( S, Init( R, APile, ATop, V ));
end;
end.